Les Jeux paralympiques sont un événement sportif international majeur, regroupant les sports d’été ou d’hiver, auquel des milliers d’athlètes handicapés participent à travers différentes compétitions tous les quatre ans à la suite des Jeux olympiques, pour chaque olympiade. Y participent des athlètes atteints par un handicap physique, visuel ou mental. Ils sont organisés par le Comité international paralympique (et non pas par le Comité international olympique).

#install.packages("tidyverse")
#install.packages("rvest")
#install.packages("skimr")
#gère différents types de données et renvoie un objet skim_df qui peut être inclus dans un pipeline tidyverse ou affiché de manière élégante pour le lecteur humain.
#install.packages("reshape2")
#Ce package permet surtout le remodelage des données. Ses deux principales fonctions sont la fonction melt, qui permet le passage d’un jeu de données de la mise en forme large à la mise en forme longue, et la fonction cast, qui permet de réaliser l’inverse. 
#install.packages("gganimate")
#Ce package permet d’ajouter des animations aux graphiques statiques produits à l’aide de ggplot2
#install.packages("magick")
#Traitement Facile des Images dans R à l’Aide du Package Magick
# Chargement des données et des bibliothèques
library(tidyverse)
library(skimr)
library(knitr)
library(rvest)
library(reshape2)
library(gganimate)
library(magick)

SW <- readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/SW.csv')

le jeu des données

SW
## # A tibble: 6,201 x 6
##    gender event               medal  athlete        abb    year
##    <chr>  <chr>               <chr>  <chr>          <chr> <dbl>
##  1 Men    25 m Freestyle 1A   Gold   KENNY Mike     GBR    1980
##  2 Men    25 m Freestyle 1A   Silver KANTOLA Pekka  FIN    1980
##  3 Men    25 m Freestyle 1A   Bronze TIETZE H.      FRG    1980
##  4 Men    25 m Freestyle 1B   Gold   BURGER M.      CAN    1980
##  5 Men    25 m Freestyle 1B   Silver SLUPE G.       USA    1980
##  6 Men    25 m Freestyle 1B   Bronze MAKI Eero      FIN    1980
##  7 Men    25 m Freestyle 1C   Gold   SMYK Zbigniew  POL    1980
##  8 Men    25 m Freestyle 1C   Silver EMMEL Manfred  FRG    1980
##  9 Men    25 m Freestyle 1C   Bronze OCKVIRK Robert USA    1980
## 10 Men    50 m Freestyle CP C Gold   ADLER Kare     NOR    1980
## # ... with 6,191 more rows

Questions:

**1.Quel le classement des pays selon les nombre de medailles depuis le début des jeux ?

compter les medailles de chaque pays

medal_count<- SW %>%
  group_by(abb, medal) %>%
  summarize(Count=length(medal)) 
medal_count
## # A tibble: 172 x 3
## # Groups:   abb [67]
##    abb   medal  Count
##    <chr> <chr>  <int>
##  1 ARG   Bronze     9
##  2 ARG   Gold       5
##  3 ARG   Silver    10
##  4 AUS   Bronze   160
##  5 AUS   Gold     147
##  6 AUS   Silver   158
##  7 AUT   Bronze     2
##  8 AUT   Gold       2
##  9 AUT   Silver     4
## 10 AZE   Gold       1
## # ... with 162 more rows

ordonner les pays par nombre de medailles

ord_med <- medal_count %>%
  group_by(abb) %>%
  summarize(Total=sum(Count)) %>%
  arrange(Total) %>%
  select(abb)
  ord_med
## # A tibble: 67 x 1
##    abb  
##    <chr>
##  1 BAH  
##  2 BUL  
##  3 KAZ  
##  4 LTU  
##  5 MAR  
##  6 TTO  
##  7 VIE  
##  8 IPP  
##  9 SLO  
## 10 TCH  
## # ... with 57 more rows
medal_count$abb <- factor(medal_count$abb, levels=ord_med$abb)

le plot

ggplot(medal_count, aes(x=abb, y=Count, fill=medal)) +
  geom_col() +
  coord_flip() +
  scale_fill_manual(values=c("gold1","gray70","gold4")) +
  ggtitle("Le classement des pays par le total des médailles ") +
  theme(plot.title = element_text(hjust = 0.5))

**2.Quel le Nombre de medailles d’or de la France au fil du temps?

FR_gold <- SW %>% group_by(year, abb, medal) %>% filter(medal=="Gold", abb=='FRA') %>% summarize(Count=n()) %>% arrange(year) %>% group_by(year)
FR_gold 
## # A tibble: 9 x 4
## # Groups:   year [9]
##    year abb   medal Count
##   <dbl> <chr> <chr> <int>
## 1  1980 FRA   Gold      4
## 2  1984 FRA   Gold     35
## 3  1988 FRA   Gold     16
## 4  1992 FRA   Gold     20
## 5  1996 FRA   Gold     12
## 6  2000 FRA   Gold     12
## 7  2004 FRA   Gold      4
## 8  2008 FRA   Gold      2
## 9  2012 FRA   Gold      2

Le plot :

ggplot(FR_gold, aes(x=year, y=Count, group=medal)) +
geom_line(aes(colour=abb)) +
geom_point(aes(colour=abb))+
scale_x_continuous(breaks=FR_gold$year)+
theme(legend.position="none", legend.text=element_text(size=0),axis.text.x=element_text(size=8, angle=90,vjust=0,hjust=1))+
labs(title="le Nombre de medailles d'or de la France au fil du temps", x="années", y="Nombre de Medailles")

**3.quel est le nombre de medailles par sex ?

ggplot(SW,aes(x= gender ,fill= medal))+
  geom_bar()+
  scale_fill_manual(values=c("gold1","gray70","gold4")) +
  ggtitle("nombre de medailles par sex ") +
  theme(plot.title = element_text(hjust = 0.5))

**4.quel est le nombre de medailles par sex pour chaque année ?

ggplot(SW,aes(x= gender ,fill= medal))+
  facet_wrap(~ year)+
  geom_bar()+
  scale_fill_manual(values=c("gold1","gray70","gold4")) +
  ggtitle("nombre de medailles par sex pour chaque année ") +
  theme(plot.title = element_text(hjust = 0.5))

**5.Quel Le nombre des hommes et des femmes au fil des années?

Tableau de comptage du nombre d’athlètes par année et sexe:

counts_sex <- SW %>%
   filter(gender != "Mixed")%>%
group_by(year,gender) %>%
  summarize(Athletes = length(unique(athlete)))
counts_sex$year <- as.integer(counts_sex$year)
counts_sex
## # A tibble: 20 x 3
## # Groups:   year [10]
##     year gender Athletes
##    <int> <chr>     <int>
##  1  1980 Men         118
##  2  1980 Women        92
##  3  1984 Men         214
##  4  1984 Women       144
##  5  1988 Men         185
##  6  1988 Women        97
##  7  1992 Men         121
##  8  1992 Women       106
##  9  1996 Men         136
## 10  1996 Women       115
## 11  2000 Men         176
## 12  2000 Women       118
## 13  2004 Men         151
## 14  2004 Women       110
## 15  2008 Men         128
## 16  2008 Women        86
## 17  2012 Men         133
## 18  2012 Women        96
## 19  2016 Men         131
## 20  2016 Women       111

Le plot:

ggplot(counts_sex, aes(x=year, y=Athletes, group=gender, color=gender)) +
  geom_point(size=2) +
  geom_line()  +
  scale_color_manual(values=c("darkblue","red")) +
  labs(title = "Le nombre des hommes et des femmes au fil des années") +
  theme(plot.title = element_text(hjust = 0.5))

**6.C’est quoi les 5 catégories les plus populaires par sexe?

Le tableau des catégories les plus populaires par sexe :

popu_event <- SW %>% 
  filter(gender != "Mixed")%>% 
  group_by(event, gender) %>%
  summarize(Count=n()) %>% 
  group_by(gender) %>% 
  top_n(5,event)
popu_event
## # A tibble: 10 x 3
## # Groups:   gender [2]
##    event                     gender Count
##    <chr>                     <chr>  <int>
##  1 50 m Freestyle S5         Women     21
##  2 50 m Freestyle S6         Women     21
##  3 50 m Freestyle S7         Men       21
##  4 50 m Freestyle S7         Women     21
##  5 50 m Freestyle S8         Men       21
##  6 50 m Freestyle S8         Women     21
##  7 50 m Freestyle S9         Men       21
##  8 50 m Freestyle S9         Women     21
##  9 75 m Individual Medley 1A Men        3
## 10 75 m Individual Medley 1B Men        3

Le plot:

ggplot(popu_event, aes(x=event, y=Count, group=gender, label=format(Count, big.mark=".", decimal.mark=","))) +
geom_col(aes(color=gender, fill=gender)) +
geom_text(position=position_stack(vjust=0.5), size=3, check_overlap=TRUE) + 
scale_y_discrete() +
theme(legend.position="right", axis.text.x=element_text(size=10, angle=90,vjust=0,hjust=1))+
labs(title="les 5 catégories les plus  populaires par sexe", x="Catégories", y="Nombre. athletes")

**7.Quels sont les pays qui n’ont pas de médaille d’or mais ils ont les autres ?

data_abb_medal <- dcast(medal_count, abb ~ medal)
data_abb_medal[is.na(data_abb_medal)] <- 0
no_gold_data <- subset(data_abb_medal, Gold == 0 & Silver>0 & Bronze>0)
no_gold_data
##    abb Bronze Gold Silver
## 10 TCH      1    0      1
## 11 KUW      2    0      1
## 20 ZIM      3    0      2
## 25 POR      6    0      3
## 29 SUI      8    0      4
## 35 URS      9    0     11
print("les pays qui n'ont pas de médaille d'or mais ils ont les autres")
## [1] "les pays qui n'ont pas de médaille d'or mais ils ont les autres"
no_gold_data$abb
## [1] TCH KUW ZIM POR SUI URS
## 67 Levels: BAH BUL KAZ LTU MAR TTO VIE IPP SLO TCH KUW LUX CRO CYP HKG ... GBR

**8.

all_medal_sex <- SW%>% group_by(abb, medal, gender) %>%
  summarise(total = n())
head(all_medal_sex)
## # A tibble: 6 x 4
## # Groups:   abb, medal [4]
##   abb   medal  gender total
##   <chr> <chr>  <chr>  <int>
## 1 ARG   Bronze Men        2
## 2 ARG   Bronze Women      7
## 3 ARG   Gold   Women      5
## 4 ARG   Silver Men        3
## 5 ARG   Silver Women      7
## 6 AUS   Bronze Men       63
all_medal_sex.wide <- dcast(all_medal_sex, abb ~ medal+gender)
all_medal_sex.wide[is.na(all_medal_sex.wide)] <- 0
head(all_medal_sex.wide)
##   abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 1 ARG          2            0            7        0          0          5
## 2 AUS         63            0           97       72          0         75
## 3 AUT          2            0            0        2          0          0
## 4 AZE          0            0            0        0          0          1
## 5 BAH          0            0            1        0          0          0
## 6 BEL          7            0            6        4          0          2
##   Silver_Men Silver_Mixed Silver_Women
## 1          3            0            7
## 2         78            0           80
## 3          4            0            0
## 4          3            0            4
## 5          0            0            0
## 6          7            0            5

**8a.Quel sont les pays où juste c’est les hommes qu’y ont gagné la médaille d’or?

no_women_gold <- subset(all_medal_sex.wide, Gold_Women ==0 & Gold_Men>0 )
no_women_gold
##    abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 3  AUT          2            0            0        2          0          0
## 7  BLR          9            0            0       21          0          0
## 12 COL          4            0            0        2          0          0
## 14 CUB          2            0            0        1          0          0
## 18 EGY          6            0            0        1          0          0
## 21 EUN          4            0            2        4          0          0
## 28 GRE         10            0            1       10          0          0
## 29 HKG          2            0            1        1          0          0
## 31 IPP          0            0            0        1          0          0
## 39 KOR          6            0            0        7          0          0
## 42 LUX          0            0            0        1          0          0
## 48 PER          2            0            0        2          0          0
## 56 SVK          2            0            1        2          0          0
## 59 THA          4            0            0        1          0          0
## 66 YUG          8            0            1        3          0          0
##    Silver_Men Silver_Mixed Silver_Women
## 3           4            0            0
## 7          14            0            0
## 12          5            0            0
## 14          2            0            0
## 18          2            0            0
## 21          2            0            1
## 28         15            0            2
## 29          0            0            0
## 31          1            0            0
## 39          2            0            0
## 42          2            0            0
## 48          1            0            0
## 56          0            0            4
## 59          3            0            0
## 66          6            0            0
print(" Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté")
## [1] " Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté"
no_women_gold$abb
##  [1] "AUT" "BLR" "COL" "CUB" "EGY" "EUN" "GRE" "HKG" "IPP" "KOR" "LUX" "PER"
## [13] "SVK" "THA" "YUG"

**8b.Quel sont les pays où les femmes qu’y ont gagné la médaille d’or ?

no_men_gold <- subset(all_medal_sex.wide, Gold_Women>0 & Gold_Men==0 )
no_men_gold 
##    abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 1  ARG          2            0            7        0          0          5
## 4  AZE          0            0            0        0          0          1
## 15 CYP          0            0            1        0          0          2
## 20 EST          1            0            2        0          0          2
## 25 FRO          0            0            5        0          0          1
## 36 JAM          0            0            0        0          0          1
## 38 KAZ          0            0            0        0          0          1
## 53 SGP          0            0            1        0          0          3
##    Silver_Men Silver_Mixed Silver_Women
## 1           3            0            7
## 4           3            0            4
## 15          0            0            1
## 20          0            0            5
## 25          0            0            7
## 36          0            0            3
## 38          0            0            0
## 53          0            0            1
print("Les pays où les hommes n'ont jamis remporté de médaille d'or mais où les femmes l'ont remporté")
## [1] "Les pays où les hommes n'ont jamis remporté de médaille d'or mais où les femmes l'ont remporté"
no_men_gold$abb
## [1] "ARG" "AZE" "CYP" "EST" "FRO" "JAM" "KAZ" "SGP"
**9.quelle la distrubtion des medailles dans le monde en 1980 et 2016?
noc <- readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/noc_regions.csv')

noc = noc %>%
  rename(abb = NOC)
noc
## # A tibble: 230 x 3
##    abb   region      notes               
##    <chr> <chr>       <chr>               
##  1 AFG   Afghanistan <NA>                
##  2 AHO   Curacao     Netherlands Antilles
##  3 ALB   Albania     <NA>                
##  4 ALG   Algeria     <NA>                
##  5 AND   Andorra     <NA>                
##  6 ANG   Angola      <NA>                
##  7 ANT   Antigua     Antigua and Barbuda 
##  8 ANZ   Australia   Australasia         
##  9 ARG   Argentina   <NA>                
## 10 ARM   Armenia     <NA>                
## # ... with 220 more rows

Ajouter les noms complets des pays à notre base

data_regions <- SW %>% 
  left_join(noc,by="abb") %>%
  filter(!is.na(region))

sous ensemble pour les jeux de 1980 et 2016,compter les athletes de chaque pays.

rio <- data_regions %>% 
  filter(year == "2016") %>%
  group_by(region) %>%
  summarize(Rio = length(unique(athlete)))

Arnhem_et_Veenendaal<- data_regions %>% 
  filter(year == "1980") %>%
  group_by(region) %>%
  summarize(Arnhem = length(unique(athlete)))

Creation des données pour la catographie

world <- map_data("world")
mapdat <- tibble(region=unique(world$region))
mapdat <- mapdat %>% 
  left_join(Arnhem_et_Veenendaal, by="region") %>%
  left_join(rio, by="region")
mapdat$Arnhem[is.na(mapdat$Arnhem)] <- 0
mapdat$Rio[is.na(mapdat$Rio)] <- 0
world <- left_join(world, mapdat, by="region")

la catographie: Arnhem et Veenendaal 1980

ggplot(world, aes(x = long, y = lat, group = group)) +
  geom_polygon(aes(fill = Arnhem)) +
  labs(title = "Arnhem et Veenendaal  1980",
       x = NULL, y = NULL) +
  theme(axis.ticks = element_blank(),
        axis.text = element_blank(),
        panel.background = element_rect(fill = "navy"),
        plot.title = element_text(hjust = 0.5)) +
  guides(fill=guide_colourbar(title="Athletes")) +
  scale_fill_gradient2(low="white",high = "red")

la catographie: Rio 2016

ggplot(world, aes(x = long, y = lat, group = group)) +
  geom_polygon(aes(fill = Rio)) +
  labs(title = "Rio 2016",
       x = NULL, y = NULL) +
  theme(axis.ticks = element_blank(),
        axis.text = element_blank(),
        panel.background = element_rect(fill = "navy"),
        plot.title = element_text(hjust = 0.5)) +
  guides(fill=guide_colourbar(title="Athletes")) +
  scale_fill_gradient2(low="white",high = "red")

La décomposition en continent :

Rajouter une colonne continent:

continent <-readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/data.csv')
continent = continent %>%
  rename(abb = Three_Letter_Country_Code)

medal_continent <- SW %>%
left_join(continent,by="abb") %>%
  filter(!is.na(Continent_Name))

**10.Combien chaque continent à de médailles ?

Le nombre de medailles en détail de chaque continent par année :

medal_continent<- medal_continent %>% 
  group_by(year,Continent_Name) %>%
  summarize(Count=length(medal)) 
medal_continent
## # A tibble: 55 x 3
## # Groups:   year [10]
##     year Continent_Name Count
##    <dbl> <chr>          <int>
##  1  1980 Africa             1
##  2  1980 Asia              25
##  3  1980 Europe           238
##  4  1980 North America    119
##  5  1980 Oceania           13
##  6  1980 South America     13
##  7  1984 Africa             1
##  8  1984 Asia              38
##  9  1984 Europe           455
## 10  1984 North America    212
## # ... with 45 more rows

Le total des medailles de chaque continent :

sum_medal_cont <- medal_continent %>%
  group_by(Continent_Name) %>%
  summarize(nombre_de_medailles=sum(Count))
 sum_medal_cont 
## # A tibble: 6 x 2
##   Continent_Name nombre_de_medailles
##   <chr>                        <int>
## 1 Africa                          10
## 2 Asia                           765
## 3 Europe                        2759
## 4 North America                 1088
## 5 Oceania                        528
## 6 South America                  178

Le pourcentage de chaque continent dans le total des médailles :

pie_chart<- sum_medal_cont %>% 
  mutate(perc = `nombre_de_medailles` / sum(`nombre_de_medailles`)) %>% 
  arrange(perc) %>%
  mutate(labels = scales::percent(perc))
pie_chart
## # A tibble: 6 x 4
##   Continent_Name nombre_de_medailles    perc labels
##   <chr>                        <int>   <dbl> <chr> 
## 1 Africa                          10 0.00188 0.2%  
## 2 South America                  178 0.0334  3.3%  
## 3 Oceania                        528 0.0991  9.9%  
## 4 Asia                           765 0.144   14.4% 
## 5 North America                 1088 0.204   20.4% 
## 6 Europe                        2759 0.518   51.8%

Le camembert :

ggplot(pie_chart, aes(x = "", y = perc, fill = Continent_Name)) +
  geom_col() +
  coord_polar(theta = "y")

**10.quelle l’evolution des nombres de medailles par continent au fil des années ?

Nous voulons ici que le nombre de médailles change en fonction des années et des continent. Nous utiliserons alors un diagramme à barres:

plot_anime1 <- ggplot(data = medal_continent) +
  geom_col(mapping = aes(x = Continent_Name, y = Count), 
           fill = "darkcyan") +
  theme_classic() +
  xlab("Continent") +
  ylab("Nombre de médailles ") +
  transition_states(year,
                    transition_length = 2,
                    state_length = 1, 
                    wrap = TRUE) +
  ggtitle("Année : {closest_state}")
plot_anime1

Les diagrammes à barres peuvent être intéressants pour comparer les données d’une seule année à la fois entre elles, mais ne permettent pas de comparer la progression du nombre de medailles par année sur un seul plan de vue. Nous pourrions alors créer un graphique à lignes avec geom_line.

plot_anime2 <- ggplot(data = medal_continent, aes(x = year, y = Count, group=Continent_Name, color=Continent_Name)) +
  geom_line() +
  geom_point() +
  ggtitle("Nombre de médailles entre 1980 et 2016") +
  ylab("Nombre de médailles") +
  xlab("Année")+
  theme_classic()+
  view_follow(fixed_x = TRUE, 
              fixed_y = TRUE) +
  transition_reveal(year)
plot_anime2 <- animate(plot_anime2, end_pause = 15)
plot_anime2